home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir35 / addcl101.zip / ADDCOL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-20  |  3KB  |  114 lines
  1. PROGRAM AddColumnOfNumbersInFile;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00  : 1993/07/14.  First public release.  DDA
  7. v1.01  : 1993/12/20.  Now handles lines up to 255 chars (not just 80).  DDA
  8.                       Added showhelp procedure, ad only shows on error.  DDA
  9.  
  10. ------------------------------------------------------------------------------}
  11.  
  12. CONST
  13.      ProgData = 'ADDCOL- Free DOS utility: adds a column of numbers in a text file.';
  14.      ProgDat2 = 'V1.01: December 20, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  15.      Usage    = 'Usage: ADDCOL <file> [<column # start in> <column width>]';
  16.  
  17. VAR
  18.    NumbFile     : Text;
  19.  
  20.    CSumStr      : String[40];
  21.    CSum         : Real;
  22.  
  23.    StartLoc,
  24.    NumbLen      : Byte;
  25.    NumbersAdded : Word;
  26.  
  27.  
  28. procedure showhelp(problem:byte); {if any *foreseen* errors arise, we are sent}
  29. var                          { here to give a little help and exit peacefully }
  30.    message : string[80];
  31. begin
  32.    writeln(progdata);                  { just tell user what this program   }
  33.    writeln(progdat2);                  { is and who wrote it                }
  34.    writeln;
  35.    writeln(usage);
  36.    writeln;
  37.    writeln('Error encountered:');
  38.    case problem of
  39.      255 : message := '';
  40.    else
  41.         message := 'Unknown error.';
  42.    end;
  43.    writeln(message);
  44.    halt(problem);
  45. end;
  46.  
  47. PROCEDURE InitGVars;
  48. VAR ValERR     : Integer;
  49. BEGIN
  50.      Assign(NumbFile,ParamStr(1));
  51. {$I-} Reset(NumbFile); {$I+}
  52.      IF ((IOResult <> 0) OR (ParamCount = 0)) THEN
  53.           showhelp (1);
  54.      IF (ParamCount = 3) THEN
  55.      BEGIN
  56.           Val(ParamStr(2),StartLoc,ValERR);
  57.           Val(ParamStr(3),NumbLen,ValERR);
  58.      END
  59.      ELSE BEGIN
  60.           StartLoc := 1;
  61.           NumbLen := 50;
  62.      END;
  63.      CSum := 0.0;
  64.      NumbersAdded := 0;
  65. END;
  66.  
  67. PROCEDURE AddTheNumbs;
  68. VAR
  69.    CNumbStr     : String;
  70.    CNumb        : Real;
  71.    ValERR       : Integer;
  72.    MaxLen       : Integer;
  73. BEGIN
  74.      MaxLen := StartLoc + NumbLen;
  75. REPEAT
  76.      ReadLn(NumbFile,CNumbStr);
  77.      IF (Length(CNumbStr) <> 0) THEN
  78.      BEGIN
  79.           Delete(CNumbStr,MaxLen,255);
  80.           WHILE (CNumbStr[Length(CNumbStr)] = ' ') DO
  81.              Delete(CNumbStr,Length(CNumbStr),1);
  82.           CNumbStr := Copy(CNumbStr,StartLoc,NumbLen);
  83.           Val(CNumbStr,CNumb,ValERR);
  84.           IF (ValERR = 0) THEN
  85.           BEGIN
  86.              CSum := CSum + CNumb;
  87.              Inc(NumbersAdded);
  88.           END;
  89.      END;
  90. UNTIL Eof (NumbFile);
  91.      Close(NumbFile);
  92. END;
  93.  
  94. FUNCTION NormalizeRealStr ( AbNormal : String ) : String;
  95. VAR LastChar : String[1];
  96. BEGIN
  97.      LastChar := Copy(AbNormal,Length(AbNormal),1);
  98.      WHILE LastChar = '0' DO
  99.      BEGIN
  100.           Delete(AbNormal,Length(AbNormal),1);
  101.           LastChar := Copy(AbNormal,Length(AbNormal),1);
  102.      END;
  103.      IF   Pos('.',AbNormal) = Length(AbNormal) THEN
  104.           Delete(AbNormal,Length(AbNormal),1);
  105.      NormalizeRealStr := AbNormal;
  106. END;
  107.  
  108. BEGIN
  109.      InitGVars;
  110.      AddTheNumbs;
  111.      Str(CSum:0:8, CSumStr);
  112.      WriteLn('The ',NumbersAdded,' numbers from "',ParamStr(1),'" total ',NormalizeRealStr(CSumStr));
  113. END.
  114.